Visual Basic 4 Database How-To/Visual Basic 4 Database - How-to (The Waite Group)(1995).iso/register.fr_/register.fr

Text File | 1995-07-19 | 9KB | 319 lines

VERSION 4.00
Begin VB.Form frmODBC
   BackColor       =   &H00C0C0C0&
   Caption         =   "ODBC Data Sources"
   ClientHeight    =   2970
   ClientLeft      =   1320
   ClientTop       =   2490
   ClientWidth     =   8490
   Height          =   3465
   Left            =   1215
   LinkTopic       =   "Form1"
   ScaleHeight     =   2970
   ScaleWidth      =   8490
   Top             =   2100
   Width           =   8700
   Begin VB.CommandButton cmdCreateDSN
      Caption         =   "&New Data Source"
      Height          =   495
      Left            =   5160
      TabIndex        =   8
      Top             =   2280
      Width           =   1455
   End
   Begin VB.Frame Frame1
      BackColor       =   &H00C0C0C0&
      Caption         =   "New Data Source"
      Height          =   1815
      Left            =   240
      TabIndex        =   10
      Top             =   240
      Width           =   4695
      Begin VB.TextBox txtDSNdesc
         Height          =   285
         Left            =   1800
         TabIndex        =   3
         Top             =   840
         Width           =   2655
      End
      Begin VB.TextBox txtDSNname
         Height          =   285
         Left            =   1800
         TabIndex        =   1
         Top             =   360
         Width           =   2655
      End
      Begin VB.ComboBox lstODBCdrivers
         Height          =   300
         Left            =   1800
         Sorted          =   -1  'True
         Style           =   2  'Dropdown List
         TabIndex        =   5
         Top             =   1320
         Width           =   2655
      End
      Begin VB.Label Label3
         Alignment       =   1  'Right Justify
         BackColor       =   &H00C0C0C0&
         Caption         =   "Select ODBC Driver:"
         Height          =   255
         Left            =   120
         TabIndex        =   4
         Top             =   1320
         Width           =   1575
      End
      Begin VB.Label Label2
         Alignment       =   1  'Right Justify
         BackColor       =   &H00C0C0C0&
         Caption         =   "Description:"
         Height          =   255
         Left            =   120
         TabIndex        =   2
         Top             =   840
         Width           =   1575
      End
      Begin VB.Label Label4
         Alignment       =   1  'Right Justify
         BackColor       =   &H00C0C0C0&
         Caption         =   "Name:"
         Height          =   255
         Left            =   120
         TabIndex        =   0
         Top             =   360
         Width           =   1575
      End
   End
   Begin VB.CommandButton cmdQuit
      Caption         =   "&Quit"
      Height          =   495
      Left            =   7080
      TabIndex        =   9
      Top             =   2280
      Width           =   1215
   End
   Begin VB.ListBox lstODBCdbs
      BackColor       =   &H00C0C0C0&
      Height          =   1590
      Left            =   5160
      Sorted          =   -1  'True
      TabIndex        =   7
      TabStop         =   0   'False
      Top             =   480
      Width           =   3135
   End
   Begin VB.Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Installed ODBC Data Sources:"
      Height          =   255
      Left            =   5160
      TabIndex        =   6
      Top             =   240
      Width           =   2535
   End
End
Attribute VB_Name = "frmODBC"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

'Dynamic arrays to hold data
Dim dbName() As String
Dim dbDesc() As String
Dim DriverDesc() As String
Dim DriverAttr() As String

Private Sub cmdCreateDSN_Click()
    CreateNewDSN
End Sub

Private Sub cmdQuit_Click()
    End
End Sub

Private Sub Form_Load()
    'Log on to an ODBC data source
    'First, allocate ODBC memory and get handles
    Dim result As Integer

    'Center the form
    Centerform

    'Allocate the ODBC environment handle
    result = ODBCAllocateEnv(ghEnv)
    If result <> SQL_SUCCESS Then
        Exit Sub
    End If

    'Load the current list of data sources to list box
    GetODBCdbs

    'Get the list of installed drivers
    GetODBCdvrs
    lstODBCDrivers.ListIndex = 0

    frmODBC.Show
    txtDSNname.SetFocus
End Sub

Private Sub GetODBCdbs()
    Dim cbDSNMax As Integer
    Dim szDSN As String * 33
    #If Win32 Then
        Dim pcbDSN As Long
        Dim pcbDescription As Long
    #Else
        Dim pcbDSN As Integer
        Dim pcbDescription As Integer
    #End If
    Dim szDescription As String * 512
    Dim cbDescriptionMax As Integer
    Dim result As Integer
    Dim i As Integer
    Dim nameLen As Integer
    Dim ErrResult
    Dim savecursor

    'Clear out the contents of the list box
    lstODBCdbs.Clear

    cbDSNMax = SQL_MAX_DSN_LENGTH + 1
    cbDescriptionMax = 512
    result = SQL_SUCCESS
    i = 0

    savecursor = Screen.MousePointer
    Screen.MousePointer = HOURGLASS
    Do While result <> SQL_NO_DATA_FOUND
        'Get the next data source (using SQL_FETCH_NEXT
        'on the first call to SQLDataSourcesgets gets
        'the first data source).
        result = SQLDataSources(ghEnv, SQL_FETCH_NEXT, szDSN, cbDSNMax, pcbDSN, szDescription, cbDescriptionMax, pcbDescription)
        If result = SQL_ERROR Then
            ErrResult = ODBCError("Env", ghEnv, 0, 0, result, "Error getting list of data sources.")
            Screen.MousePointer = savecursor
            Exit Sub
        End If

        'Add the data source data to the global arrays
        ReDim Preserve dbName(i)
        dbName(i) = Left(szDSN, pcbDSN)
        ReDim Preserve dbDesc(i)
        dbDesc(i) = Left(szDescription, pcbDescription)

        lstODBCdbs.AddItem dbName(i) & "  (" & dbDesc(i) & ")"

        i = i + 1
    Loop
    Screen.MousePointer = savecursor

End Sub

Private Sub GetODBCdvrs()
    Dim szDriverDesc As String * 512
    Dim cbDriverDescMax As Integer
    #If Win32 Then
        Dim pcbDriverDesc As Long
        Dim pcbDrvrAttr As Long
    #Else
        Dim pcbDriverDesc As Integer
        Dim pcbDrvrAttr As Integer
    #End If
    Dim szDriverAttributes As String * 2048
    Dim cbDrvrAttrMax As Integer
    Dim i As Integer
    Dim result As Integer
    Dim ErrResult As Integer
    Dim savecursor

    cbDriverDescMax = 512
    cbDrvrAttrMax = 2048
    result = SQL_SUCCESS
    i = 0

    savecursor = Screen.MousePointer
    Screen.MousePointer = HOURGLASS
    Do While result <> SQL_NO_DATA_FOUND
        'On the first call to SQLDrivers, using
        'SQL_FETCH_NEXT gets the first driver.
        result = SQLDrivers(ghEnv, SQL_FETCH_NEXT, szDriverDesc, cbDriverDescMax, pcbDriverDesc, szDriverAttributes, cbDrvrAttrMax, pcbDrvrAttr)
        If result = SQL_ERROR Then
            ErrResult = ODBCError("Env", ghEnv, 0, 0, result, "Error getting list of registered drivers.")
            'Screen.MousePointer = save
            Exit Sub
        End If

        'Add the driver information to the data arrays,
        'and add to the lstODBCDrivers list box.
        ReDim Preserve DriverDesc(i)
        DriverDesc(i) = Left(szDriverDesc, pcbDriverDesc)
        ReDim Preserve DriverAttr(i)
        DriverAttr(i) = Left(szDriverAttributes, pcbDrvrAttr)

        lstODBCDrivers.AddItem DriverDesc(i) & "  (" & DriverAttr(i) & ")"

        i = i + 1
    Loop

    Screen.MousePointer = savecursor

End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim result As Integer

    'Clean up the ODBC connections that we allocated
    'and opened.
    result = ODBCDisconnectDS(ghEnv, ghDbc, ghStmt)
    result = ODBCFreeEnv(ghEnv)
End Sub

Sub CreateNewDSN()
    'Add a new data source name to the ODBC system
    Dim DSNname As String
    Dim DSNattrib As String
    Dim DSNdriver As String
    Dim result As Integer
    Dim savecursor

    If txtDSNname = "" Then
        MsgBox "You must enter a name for the new data source."
        txtDSNname.SetFocus
    Else
        savecursor = Screen.MousePointer
        Screen.MousePointer = HOURGLASS

        'Format the arguments to RegisterDatabase
        DSNname = txtDSNname.text
        DSNattrib = "Description=" & txtDSNdesc.text
        DSNdriver = lstODBCDrivers.List(lstODBCDrivers.ListIndex)

        On Error GoTo CantRegister
        'Trap any errors so we can respond to them
        DBEngine.RegisterDatabase DSNname, DSNdriver, False, DSNattrib
        On Error GoTo 0

        'Now, rebuild the list of data source names
        GetODBCdbs

        Screen.MousePointer = savecursor
    End If

    Exit Sub

CantRegister:
    If Err.Number = 3146 Then
        'ODBC couldn't find the setup driver specified
        'for this database in ODBCINST.INI.
        MsgBox "Cannot find driver installation DLL.", MB_ICONSTOP
        Resume Next
    Else
        Error Err.Number
    End If

End Sub

Sub Centerform()
    frmODBC.Move (Screen.Width - frmODBC.Width) / 2, (Screen.Height - frmODBC.Height) / 2
End Sub